home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir31 / gusutils.zip / GUSWAV.PAS < prev    next >
Pascal/Delphi Source File  |  1994-02-09  |  16KB  |  560 lines
  1. (****************************************************************************)
  2. (* Module     : GUSWAV.PAS                                                  *)
  3. (* Verion     : 0.8ß                                                        *)
  4. (* Date       : Thu Feb 3, 1994                                             *)
  5. (* Pascal     : TP 7.0                                                      *)
  6. (****************************************************************************)
  7. (*                                                                          *)
  8. (* NOTICE OF COPYRIGHT AND OWNERSHIP OF SOFTWARE:                           *)
  9. (*                                                                          *)
  10. (* Copyright (C) 1993, 1994 by MESS Computer Services.                      *)
  11. (* Portions Copyright (C) 1993, 1994 by TBP Electronics Ltd.                *)
  12. (* All rights reserved.                                                     *)
  13. (*                                                                          *)
  14. (****************************************************************************)
  15. (* MESS Computer Services V.O.F.        MM   MM  EEEEEE   SSSSS   SSSSS     *)
  16. (* Jadestraat 54                        M M M M  E       S       S          *)
  17. (* 4817 JK  Breda                       M  M  M  EEEE     SSSS    SSSS      *)
  18. (* The Netherlands                      M     M  E            S       S     *)
  19. (*                                      M     M  EEEEEE  SSSSS   SSSSS      *)
  20. (* Tel: +31-76 22 34 31                                                     *)
  21. (* Fax: +31-76 20 46 23               Many Efforts for Structured Systems   *)
  22. (* Email: appel@stack.urc.tue.nl                                            *)
  23. (****************************************************************************)
  24.  
  25.  
  26. {$A-,B-,D+,E-,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S-,T-,V-,X+}
  27. {$M 4096,0,0}
  28.  
  29. program GusWav;
  30.  
  31. uses
  32.   Dos, Gus;
  33.  
  34. type
  35.   NameType  = array [1..8] of Char;
  36.  
  37.   GusSample = record
  38.     Id       : array[1..4] of Char;
  39.     Name     : NameType;
  40.     Start    : LongInt;
  41.     Stop     : LongInt;
  42.     Freq     : Word;
  43.     Bits     : Byte;
  44.     Chan     : Byte;
  45.     Reserved : array[1..8] of Byte;
  46.   end;
  47.  
  48. const
  49.   Hex : array [0..15] of Char = '0123456789ABCDEF';
  50.  
  51.   Empty : GusSample = (Id       : 'MESS';
  52.                        Name     : '        ';
  53.                        Start    : 0;
  54.                        Stop     : 0;
  55.                        Freq     : 0;
  56.                        Bits     : 0;
  57.                        Chan     : 0;
  58.                        Reserved : (0,0,0,0,0,0,0,0));
  59.  
  60.   InvalidWav : String [20] = 'Error in .wav file: ';
  61.  
  62.   SampleBank = 32;
  63.  
  64. var
  65.   GusIndex  : array [1..SampleBank] of GusSample;
  66.   Available : LongInt;
  67.  
  68.   Handle    : File;
  69.   Buffer    : Array [1.. 40320] of Byte;
  70.   BufSize   : Word;
  71.   GusPtr    : LongInt;
  72.  
  73.   Path      : String;
  74.   Filename  : String;
  75.   Extension : String;
  76.  
  77.   Index     : Byte;
  78.  
  79.   Sounds    : Boolean;
  80.  
  81. function UpStr (St : String) : String;
  82. var
  83.   Loop : Byte;
  84. begin
  85.   UpStr[0] := St[0];
  86.   for Loop := 1 to Length(St)
  87.     do UpStr[Loop] := UpCase (St[Loop]);
  88. end;
  89.  
  90. function HexStr (L : LongInt) : String;
  91. var
  92.   St : String;
  93. begin
  94.   St := '00000';
  95.  
  96.   St[1] := Hex[L and $F0000 shr 16];
  97.   St[2] := Hex[L and $0F000 shr 12];
  98.   St[3] := Hex[L and $00F00 shr  8];
  99.   St[4] := Hex[L and $000F0 shr  4];
  100.   St[5] := Hex[L and $0000F shr  0];
  101.  
  102.   HexStr := St;
  103. end;
  104.  
  105. procedure Copyright;
  106. begin
  107.   WriteLn;
  108.   WriteLn ('Gravis Ultrasound Wave Player            V0.8ß');
  109.   WriteLn ('(C)Copyright MESS Computer Services 1993, 1994');
  110.   WriteLn;
  111. end;
  112.  
  113. procedure InitGus;
  114. var
  115.   Index  : Byte;
  116.   Reload : Boolean;
  117. begin
  118.   (* GUS MEMORY AVAILABLE *)
  119.   Available := LongInt(GusMemory) * 1024 - 1;
  120.  
  121.   (* READ GUSINDEX *)
  122.   GusRead (0, GusIndex, SizeOf (GusIndex));
  123.  
  124.   (* TEST GUSINDEX *)
  125.   Reload := False;
  126.   Index := 1;
  127.   repeat
  128.     Reload := Reload or (GusIndex[Index].Id <> Empty.Id);
  129.     Inc (Index);
  130.   until (Reload or (Index > SampleBank));
  131.  
  132.   (* GUSINDEX NOT O.K. -> RESET GUS *)
  133.   if Reload then
  134.   begin
  135.     (* GUS INIT *)
  136.     GusInit (14);
  137.  
  138.     (* RESET & WRITE GUSINDEX *)
  139.     for Index := 1 to SampleBank do GusIndex[Index] := Empty;
  140.     GusWrite (0, GusIndex, SizeOf (GusIndex));
  141.  
  142.     (* OUTPUT ON *)
  143.     GusMixer (LineOut + LineIn);
  144.   end;
  145.  
  146.   (* PLAY ALL SOUNDS *)
  147.   Sounds := True;
  148. end;
  149.  
  150. procedure ShowIndex;
  151. var
  152.   Index  : Byte;
  153.   L1, L2 : Byte;
  154. begin
  155.   Copyright;
  156.  
  157.   if (GusBase = 0) then
  158.   begin
  159.     Write ('Error: ');
  160.     if MegaEm
  161.       then WriteLn ('Mega-Em is active.')
  162.       else WriteLn ('No Ultrasound card found.');
  163.     Halt (1);
  164.   end;
  165.  
  166.   WriteLn ('Nr  Name      Start   Stop    Freq   Bits        Time    Voices');
  167.   WriteLn ('--  --------  ------  ------  -----  ----------  ------  ------------');
  168.  
  169.   for Index := 1 to SampleBank do
  170.   begin
  171.     if (GusIndex[Index].Freq <> 0) then
  172.     begin
  173.       if (Index <> 1) and ((Index - 1) mod 16 = 0) then
  174.       begin
  175.         Write ('-- More --');
  176.         asm
  177.           push   ax
  178.           xor    ah, ah
  179.           int    16h
  180.           pop    ax
  181.         end;
  182.         WriteLn; WriteLn;
  183.       end;
  184.  
  185.       Write (Index:2, '  ', GusIndex[Index].Name:8, '  ',
  186.              HexStr(GusIndex[Index].Start), 'h  ', HexStr(GusIndex[Index].Stop), 'h  ',
  187.              GusIndex[Index].Freq:5, '  ', GusIndex[Index].Bits:2, ' ');
  188.  
  189.       case GusIndex[Index].Chan of
  190.         1 : Write ('Mono     ');
  191.         2 : Write ('Stereo   ');
  192.         else Write ('Multi-', GusIndex[Index].Chan, '  ');
  193.       end;
  194.  
  195.       Write  (((GusIndex[Index].Stop - GusIndex[Index].Start) shr
  196.               (GusIndex[Index].Bits shr 4) shr (GusIndex[Index].Chan shr 1) /
  197.               GusIndex[Index].Freq):5:1, 's  ');
  198.  
  199.       L2 := 0;
  200.       for L1 := 0 to GusVoices do
  201.       begin
  202.         if VoiceActive(L1) and (GetVoiceLoc (L1, LoopEnd) > GusIndex[Index].Start) and
  203.            (GetVoiceLoc (L1, LoopEnd) <= GusIndex[Index].Stop) then
  204.         begin
  205.           if (L2 >= 9) then
  206.           begin
  207.             if (L2 <= 12) then Write (Copy('....', 1, 13-L2));
  208.             L2 := 13;
  209.           end
  210.             else
  211.           begin
  212.             if (L2 > 0) then Write (',');
  213.             Write (L1+1);
  214.           end;
  215.           if (L1 >= 9) then Inc (L2, 3) else Inc (L2, 2);
  216.         end;
  217.       end;
  218.       WriteLn;
  219.     end;
  220.   end;
  221. end;
  222.  
  223. function LoadFile (Index : Byte) : Boolean;
  224. var
  225.   St       : String;
  226.   Loop     : Word;
  227.   Chan     : Byte;
  228.   NxtLen   : LongInt;
  229.   MaxLen   : LongInt;
  230.   Header   : array [1..16] of Word absolute Buffer;
  231.   DataPtr  : LongInt;
  232. begin
  233.   (* FILENAME *)
  234.   LoadFile := False;
  235.   Filename := Filename + '.WAV';
  236.   if (GusIndex[Index].Start >= Available) then Exit;
  237.  
  238.   (* OPEN FILE *)
  239.   Assign (Handle, Path + Filename);
  240.   Reset (Handle, 1);
  241.  
  242.   if (IOResult = 0) then
  243.   begin
  244.     (* CHECK WAV HEADER *)
  245.     St[0] := Chr(12);
  246.     BlockRead (Handle, St[1], 12, BufSize);
  247.     Delete (St, 5, 4);
  248.     if (St <> 'RIFFWAVE') then
  249.     begin
  250.       WriteLn (InvalidWav, Filename);
  251.       Exit;
  252.     end;
  253.  
  254.     (* CHECK WAV FORMAT *)
  255.     St[0] := Chr(255);
  256.     BlockRead (Handle, St[1], 255, BufSize);
  257.     BufSize := Pos ('fmt ', St);
  258.     Delete (St, 1, BufSize-1);
  259.     if (BufSize = 0) or (Pos ('data', St) <> 25)then
  260.     begin
  261.       WriteLn (InvalidWav, Filename);
  262.       Exit;
  263.     end;
  264.     Seek (Handle, 12 + BufSize - 1);
  265.     BlockRead (Handle, Buffer, 32, BufSize);
  266.     DataPtr := FilePos (Handle);
  267.  
  268.     (* GUSINDEX.FREQ & GUSINDEX.BITS *)
  269.     GusPtr := GusIndex[Index].Start;
  270.     GusIndex[Index].Bits := Header[12];
  271.     GusIndex[Index].Chan := Header[6];
  272.     GusIndex[Index].Freq := Header[7] shr (Header[6] shr 1);
  273.  
  274.     if GusIndex[Index].Bits = 16 then
  275.     begin
  276.       GusDataConvert := False;
  277.       GusData16Bits  := True;
  278.     end
  279.       else
  280.     begin
  281.       GusDataConvert := True;
  282.       GusData16Bits  := False;
  283.     end;
  284.  
  285.     if (GusIndex[Index].Chan > (8 shr (GusIndex[Index].Bits shr 4))) then
  286.     begin
  287.       WriteLn (GusIndex[Index].Bits, ' bits multi-channel .wav files with ',
  288.                (8 shr (GusIndex[Index].Bits shr 4) + 1), ' or more channels',
  289.                ' are not supported...');
  290.       Exit;
  291.     end;
  292.  
  293.     (* MAX LENGTH *)
  294.     MaxLen := Available - GusPtr - GusIndex[Index].Chan shl (GusIndex[Index].Bits shr 4);
  295.  
  296.     for Chan := 1 to GusIndex[Index].Chan do
  297.     begin
  298.       Seek (Handle, DataPtr);
  299.  
  300.       (* NEXT LENGTH *)
  301.       NxtLen := MaxLen div GusIndex[Index].Chan;
  302.  
  303.       while not EOF (Handle) do
  304.       begin
  305.         BlockRead (Handle, Buffer, SizeOf (Buffer), BufSize);
  306.  
  307.         if (BufSize div GusIndex[Index].Chan >= NxtLen) then
  308.         begin
  309.           BufSize := NxtLen * GusIndex[Index].Chan;
  310.           Seek (Handle, FileSize(Handle));
  311.         end;
  312.  
  313.         if (GusIndex[Index].Chan <> 1) then
  314.         begin
  315.           BufSize := BufSize div GusIndex[Index].Chan;
  316.  
  317.           for Loop := 0 to BufSize - 1
  318.             do Buffer[Loop+1] := Buffer[Loop * GusIndex[Index].Chan + Chan];
  319.         end;
  320.  
  321.         GusWrite (GusPtr, Buffer, BufSize);
  322.  
  323.         Dec (NxtLen, BufSize);
  324.         Inc (GusPtr, BufSize);
  325.       end;
  326.  
  327.       (* GUSPTR = NEXT SAMPLE BYTE *)
  328.       GusPtr := (GusPtr and $FFFFE);
  329.       GusPoke (GusPtr, $00);
  330.       Inc (GusPtr);
  331.       if GusIndex[Index].Bits <> 8 then
  332.       begin
  333.         GusPoke (GusPtr, $00);
  334.         Inc (GusPtr);
  335.       end;
  336.     end;
  337.  
  338.     (* GUSDATA *)
  339.     GusDataConvert := False;
  340.     GusData16Bits  := False;
  341.  
  342.     (* GUSINDEX.STOP *)
  343.     GusIndex[Index].Stop := GusPtr;
  344.  
  345.     (* CLOSE FILE *)
  346.     Close (Handle);
  347.  
  348.     (* LOADFILE := TRUE (O.K.) *)
  349.     LoadFile := True;
  350.   end;
  351. end;
  352.  
  353. function FindFile (Name : String) : Byte; (* NAME = UPCASE *)
  354. var
  355.   Found  : Boolean;
  356.   Index  : Byte;
  357.   Loop   : Byte;
  358. begin
  359.   (* SEARCH NAME *)
  360.   Name := Copy (Name+'        ', 1, 8);
  361.   Index := 0;
  362.  
  363.   (* SEARCH *)
  364.   repeat
  365.     Inc (Index);
  366.     Found := True;
  367.     for Loop := 1 to 8
  368.       do Found := Found and (GusIndex[Index].Name[Loop] = Name[Loop]);
  369.   until (Found or (GusIndex[Index].Freq = 0) or (Index > SampleBank));
  370.  
  371.   (* NOT FOUND *)
  372.   if not Found and (Index <= SampleBank) then
  373.   begin
  374.     (* GUSINDEX.NAME *)
  375.     for Loop := 1 to 8
  376.       do GusIndex[Index].Name[Loop] := Name[Loop];
  377.     (* GUSINDEX.START *)
  378.     if (Index > 1)
  379.       then GusIndex[Index].Start := ((GusIndex[Index-1].Stop - 1) shr 5 + 1) shl 5
  380.       else GusIndex[Index].Start := SampleBank * SizeOf(GusSample);
  381.     (* WRITE GUSINDEX *)
  382.     if LoadFile (Index)
  383.       then GusWrite (0, GusIndex, SizeOf (GusIndex))
  384.       else Index := 0;
  385.   end;
  386.  
  387.   (* FINDFILE *)
  388.   if (Index > SampleBank) then Index := 0;
  389.   FindFile := Index;
  390. end;
  391.  
  392. procedure PlayFile (Nr : Byte);
  393. var
  394.   Voice : array [1..8] of Byte;
  395.   Index : Byte;
  396.   Len   : LongInt;
  397. begin
  398.   if Sounds then
  399.   begin
  400.     if ((Nr >= 1) and (Nr <= SampleBank)) then
  401.     begin
  402.       (* FREE VOICES *)
  403.       Voice[1] := 0;
  404.       for Index := 1 to GusIndex[Nr].Chan do
  405.       begin
  406.         while VoiceActive (Voice[Index]) and (Voice[Index] < GusVoices)
  407.           do Inc (Voice[Index]);
  408.         if (Index < GusIndex[Nr].Chan) then Voice[Index + 1] := Voice [Index] + 1;
  409.       end;
  410.  
  411.       for Index := 1 to GusIndex[Nr].Chan do
  412.       begin
  413.         if (Voice[Index] < GusVoices) then
  414.         begin
  415.           (* VOICE BALANCE *)
  416.           if GusIndex[Nr].Chan = 1 then VoiceBalance (Voice[Index], Middle)
  417.             else
  418.           begin
  419.             if Odd (Index)
  420.               then VoiceBalance (Voice[Index], Left)
  421.               else VoiceBalance (Voice[Index], Right);
  422.           end;
  423.  
  424.           (* VOICE VOLUME *)
  425.           VoiceVolume (Voice[Index], $000);
  426.  
  427.           (* VOICE MODE *)
  428.           if (GusIndex[Nr].Bits = 8)
  429.             then VoiceMode (Voice[Index], Bit8 + LoopOff + UniDir + Forw)
  430.             else VoiceMode (Voice[Index], Bit8 + LoopOff + UniDir + Forw);
  431.             (* SHOULD BE: BIT16 *)
  432.  
  433.           (* VOICE FREQ *)
  434.           VoiceFreq (Voice[Index], GusIndex[Nr].Freq shl (GusIndex[Nr].Bits shr 4));
  435.           (* BECAUSE: BITS8 *)
  436.  
  437.           (* VOICE SAMPLE *)
  438.           Len := (GusIndex[Nr].Stop - GusIndex[Nr].Start) div GusIndex[Nr].Chan;
  439.           VoiceSample (Voice[Index],
  440.                        GusIndex[Nr].Start + (Index - 1) * Len,
  441.                        GusIndex[Nr].Start + (Index - 1) * Len,
  442.                        GusIndex[Nr].Start  + Index * Len);
  443.  
  444.           (* VOICE RAMP *)
  445.           RampRate (Voice[Index], 0, 34);
  446.           RampRange (Voice[Index], $000, $F00);
  447.           RampMode (Voice[Index], LoopOff+UniDir+Up);
  448.         end;
  449.       end;
  450.  
  451.       for Index := 1 to GusIndex[Nr].Chan do
  452.       begin
  453.         if (Voice[Index] < GusVoices) then
  454.         begin
  455.           VoiceStart (Voice[Index]);
  456.           RampStart (Voice[Index]);
  457.         end;
  458.       end;
  459.     end;
  460.   end;
  461. end;
  462.  
  463. begin
  464.   InitGus;
  465.  
  466.   (* ANTI-VOLUME-CLIPPING *)
  467.   for Index := 0 to GusVoices - 1 do
  468.     if not VoiceActive (Index) then VoiceInit (Index);
  469.  
  470.   (* INDEX *)
  471.   if (ParamCount = 0) then ShowIndex
  472.     else
  473.  
  474.   for Index := 1 to ParamCount do
  475.   begin
  476.     (* FILENAME OR PARAMETER *)
  477.     FSplit (UpStr(ParamStr(Index)), Path, Filename, Extension);
  478.     if (Filename[1] = '/') or (Filename[1] = '-')
  479.     then Delete (Filename, 1, 1);
  480.  
  481.     (* INDEX *)
  482.     if (Filename = 'INDEX') or (Filename = 'X') then
  483.     begin
  484.       ShowIndex;
  485.     end else begin
  486.  
  487.     (* SILENCE *)
  488.     if (Filename = 'LOAD') or (Filename = 'L') then
  489.     begin
  490.       Sounds := False;
  491.     end else begin
  492.  
  493.     (* SOUND ON *)
  494.     if (Filename = 'PLAY') or (Filename = 'P') then
  495.     begin
  496.       Sounds := True;
  497.     end else begin
  498.  
  499.     (* INIT *)
  500.     if (Filename = 'INIT') or (Filename = 'I') then
  501.     begin
  502.       (* INIT GUS *)
  503.       GusInit (14);
  504.  
  505.       (* OUTPUT ON *)
  506.       GusMixer (LineOut + LineIn);
  507.  
  508.       (* SOUNDS ON *)
  509.       Sounds := True;
  510.     end else begin
  511.  
  512.     (* CLEAR *)
  513.     if (Filename = 'CLEAR') or (Filename = 'C') then
  514.     begin
  515.       (* STOP VOICES *)
  516.       for BufSize := 0 to GusVoices - 1 do VoiceInit (BufSize);
  517.       (* RESET INDEX *)
  518.       for BufSize := 1 to SampleBank do GusIndex[BufSize] := Empty;
  519.       GusWrite (0, GusIndex, SizeOf (GusIndex));
  520.     end else begin
  521.  
  522.     (* HELP *)
  523.     if (Filename = 'HELP') or (Filename = '?') then
  524.     begin
  525.       Copyright;
  526.       WriteLn ('Usage : GUSWAV [options] [switches] [drive:][path][filename] [#no]');
  527.       WriteLn;
  528.       WriteLn ('Options   Short  Explanation');
  529.       WriteLn ('--------  -----  -------------------------------------------------------');
  530.       WriteLn (' Stop      -S     Stop all samples from playing.');
  531.       WriteLn (' Init      -I     Initialize the Ultrasound but leave samples in memory.');
  532.       WriteLn (' Clear     -C     Clear all samples from the Ultrasound memory.');
  533.       WriteLn (' Index     -X     Show the samples in the Ultrasound memory (default).');
  534.       WriteLn (' Help      -?     Shows this help text.');
  535.       WriteLn;
  536.       WriteLn ('Switches  Short  Explanation');
  537.       WriteLn ('--------  -----  -------------------------------------------------------');
  538.       WriteLn (' Load      -L     Just load samples, don''t play.');
  539.       WriteLn (' Play      -P     Load and play samples (default).');
  540.     end else begin
  541.  
  542.     (* STOP *)
  543.     if (Filename = 'STOP') or (Filename = 'S')  then
  544.     begin
  545.       (* STOP VOICES *)
  546.       for BufSize := 0 to GusVoices - 1 do VoiceInit (BufSize);
  547.     end else
  548.  
  549.     (* NUMBER OR FILENAME *)
  550.     begin
  551.       Val (Filename, BufSize, BufSize);
  552.       if (BufSize < 1) or (BufSize > SampleBank) then PlayFile (FindFile (Filename))
  553.         else if (GusIndex[BufSize].Freq <> 0) then PlayFile (BufSize);
  554.     end; end; end; end; end; end; end; end;
  555.  
  556.   (* ANTI-VOLUME-CLIPPING *)
  557.   for Index := 0 to GusVoices - 1 do
  558.     if not VoiceActive (Index) then VoiceInit (Index);
  559. end.
  560.